#-*- mode: perl; coding:utf-8 -*-
#State Chart Library
#  Need GraphViz
package Stlib;

use utf8;
use Encode;

sub Initialize {
    $Debug = 0;
    $Debug && print "Stlib::Initialize\n";
    
    %Groups = ();
    $Groups{" "} = "g0";
    %States = ();
    $NewId = 1;
    %Transitions = ();
    @TransitionFrom = ();
    @TransitionTo = ();
    @TransitionEvent = ();
    $NumTransition = 0;
    $OldGroup = "";
    $OldState = "";
}

#遷移追加
sub AddTransition {
    my ($from_group, $from_state, $to_group, $to_state, $event) = @_;
    $Debug && print "Stlib::AddTransition($from_group, $from_state, $to_group, $to_state, $event)\n";
    my $from_id = &AddState($from_group, $from_state);
    my $to_id = &AddState($to_group, $to_state);
    
    if ($UNIQUE) {                                               # 重複破棄
		my($t) = "$from_id,$to_id,$event";
		if ($Transitions{$t}) {
            $OldGroup = $to_group;
            $OldState = $to_state;
			return;
		}
		$Transitions{$t} = 1;
    }
    $TransitionTo[$NumTransition] = $to_id;
    $TransitionFrom[$NumTransition] = $from_id;
    $TransitionEvent[$NumTransition] = $event;
    $NumTransition++;
    $OldGroup = $to_group;
    $OldState = $to_state;
}

# 遷移追加
sub AddTransitionSeq {
    my ($group, $state, $event) = @_;
    if ($OldState) {
        &AddTransition($OldGroup, $OldState,
                       $group, $state, $event);
    } else {
        $OldGroup = $group;
        $OldState = $state;
    }
    return;
}

# 出力処理
sub OutputDot {
    my ($OutDot) = @_;
    my (%group);
    my ($state);
    my ($num) = 0;
    $Debug && print "Stlib::OutputDot $OutDot \n";
    open(OUTDOT, ">:utf8", "$OutDot");	# FILEを開く
    &OutputHeader();
    # subgraph
    foreach $group_name (keys(%Groups)) {
        $group_id = $Groups{$group_name};
		if ($group_name != 1 && $group_id ne "g0") { 
			print OUTDOT "    subgraph cluster_$group_id {\n";
			print OUTDOT "        label =\"$group_name\";\n";
			print OUTDOT "        color = \"Blue\";\n";
			foreach $state (keys(%States)) {
				if ($state =~ /^([^;]*)\;(.*)$/) {
					if ($1 eq $group_name) {
                        my $id = $States{$state};
                        &OutputNode($id, $2);
					}
				}
			}
			print OUTDOT "    }\n";
		} 
	}
    foreach $state (keys(%States)) { 
		if ($state =~ /^\s*\;(.*)$/) {
            my $id = $States{$state};
            &OutputNode($id, $1);
		}
    }

    #Arrow
    for ($i = 0; $i < $NumTransition; $i++) {
		#s -> s0 [ label = "OK" ];
		print OUTDOT "    $TransitionFrom[$i] -> $TransitionTo[$i] [label = \"$TransitionEvent[$i]\" ];\n";
    }
    print OUTDOT "}";
    close(OUTDOT);			# FILEを閉じる	
}


sub OutputNode {
    my ($id, $label) = @_;
    my $dot_label = &StateLabel($label);

    if (&IsStartLabel($id, $label)) {
        &OutputStartNode($id, $dot_label);
    } elsif (&IsEndLabel($id, $label)) {
        &OutputEndNode($id, $dot_label);
    } else {
        print OUTDOT "        $id [label=\"$dot_label\"];\n";
    }
}
sub AddState {
    my ($group, $state) = @_;
    $state = &Unique($state);
    unless ($group) {
        $group = " ";
    }
    unless ($Groups{$group}) {
        $Groups{$group} = "g$NewId";
        $NewId++;
    }
    unless ($States{"$group;$state"}) {
        $States{"$group;$state"} = "s$NewId";
        $NewId++;
    }
    return $States{"$group;$state"};
}

sub Unique {
    my ($name) = @_;
    $name =~ s/\s//g;
    return $name;
}

sub StateLabel {
    my ($label) = @_;
    if ($label =~ /\{(.*)\}/) {
        $label = $1;
        $label =~ s/\,/\\n/g;
    }
    return $label;
}

sub OutputHeader {
    print OUTDOT <<END_OF_DATA;
digraph finite_state_machine {
    fontsize = 12;
    nodesep = 1.0;
    ranksep = 1.0;
    graph [
       rankdir = "LR"
    ];
    node [shape = circle, fixedsize = false , height = 1.0, width=1.0,
          fontname = "Arial", fontsize = 9,
          style = filled, color = "#000000", fillcolor = "#9966FF"];
    graph [nodesep = 0.7, fontname = "Arial", fontsize = 9];
    edge [fontname = "Arial", fontsize = 9];
END_OF_DATA
}

sub IsStartLabel {
    my ($id, $label) = @_;
    if ($label =~ /^\([^\(](.*)\)/) {
        return 1;
    }
    return 0;
}

sub IsEndLabel {
    my ($id, $label) = @_;
    if ($label =~ /^\(\((.*)\)\)/) {
        return 1;
    }
    return 0;
}

sub OutputStartNode {
    my ($id, $label) = @_;
    if ($label =~ /\((.*)\)/) {
        $label = $1;
    }
    print OUTDOT <<END_OF_DATA;
    s_$id -> $id;
    $id [label="$label"];
    s_$id [style=filled,fillcolor=black,color=black,shape = circle, fixedsize = true , height = 0.2, width=0.2, label = ""];
END_OF_DATA
}
sub OutputEndNode {
    my ($id, $label) = @_;
    if ($label =~ /\(\((.*)\)\)/) {
        $label = $1;
    }
    print OUTDOT <<END_OF_DATA;
    $id -> e_$id;
    $id [label="$label"];
    e_$id [style=filled,fillcolor=black,color=black,shape = doublecircle, fixedsize = true , height = 0.2, width=0.2, label = ""];
END_OF_DATA
}

1;


